HPAVC/HPAVC CD-ROM.iso/pc/OOPTUT34.ZIP/STREAMS.PAS

Pascal/Delphi Source File | 1993-06-14 | 11.3 KB | 390 lines

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
{$M 4096,0,20000}

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{   Turbo Pascal 6.0       Demo program from the Turbo Vision Guide.    }
{                                                                       }
{   TVGUID21.PAS    Copyright (c) 1990 by Borland International         }
{                                                                       }
{   Modification  10.8.91.    Further addition  21.11.92.               }
{   Now provides screen display of details of Stream Registration and   }
{   Graphical Shapes. DOS Debug is also used to display a memory check  }
{   for the collection of graphical shapes and to inspect the stream    }
{   file GRAPHICS.STM                                                   }
{                                                                       }
{   STREAMS.PAS  ->  .EXE    R Shaw    21.11.92                         }
{                                                                       }
{_______________________________________________________________________}

{ Create and display a collection of graphical objects:
  Points, Circles, Rectangles. Then put them on a stream
  to be read by another program (TVGUID22.PAS).

  If you are running this program in the IDE, be sure to
  enable the full graphics save option when you load TURBO.EXE:

    turbo -g

  This ensures that the IDE fully swaps video RAM and keeps
  "dustclouds" from appearing on the user screen when in
  graphics mode. You can enable this option permanently
  via the Options|Environment|Startup dialog.

  This program uses the Graph unit and its .BGI driver files to
  display graphics on your system. The "PathToDrivers"
  constant defined below is now set to \TP\OOPTUTOR, instead of
  \TP\BGI as in the original Borland program.
}

program STREAMS;

uses
   Dos, Objects, Graph, Crt, Hex;

const
  PathToDrivers = '\TP\OOPTUTOR';
var
  answer     : char;
  reply      : char;
  MaxX, MaxY : integer;

{ ********************************** }
{ ******  Graphical Objects  ******* }
{ ********************************** }

type
  PGraphObject = ^TGraphObject;
  TGraphObject = object(TObject)
    X,Y: Integer;
    constructor Init;
    procedure Draw; virtual;
    procedure Store(var S: TStream); virtual;
  end;

  PGraphPoint = ^TGraphPoint;
  TGraphPoint = object(TGraphObject)
    procedure Draw; virtual;
  end;

  PGraphCircle = ^TGraphCircle;
  TGraphCircle = object(TGraphObject)
    Radius: Integer;
    constructor Init;
    procedure Draw; virtual;
    procedure Store(var S: TStream); virtual;
  end;

  PGraphRect = ^TGraphRect;
  TGraphRect = object(TGraphObject)
    Width, Height: Integer;
    constructor Init;
    procedure Draw; virtual;
    procedure Store(var S: TStream); virtual;
  end;

{ TGraphObject }
constructor TGraphObject.Init;
begin
  X := Random(MaxX);
  Y := Random(MaxY);
  write('X = ',X:3,'   Y = ',Y:3);    {Added by RS to display values for  }
end;                                  { checking by DOS Debug graphics.stm }

procedure TGraphObject.Draw;
begin
  Abstract;     { Give error: This object should never be drawn }
end;

procedure TGraphObject.Store(var S: TStream);
begin
  S.Write(X, SizeOf(X));
  S.Write(Y, SizeOf(Y));
end;

{ TGraphPoint }
procedure TGraphPoint.Draw;
var
  DX, DY: Integer;
begin
  { Make it a fat point so you can see it }
  for DX := x - 2 to x + 2 do
    for DY := y - 2 to y + 2 do
      PutPixel(DX, DY, 1);
end;

{ TGraphCircle }
constructor TGraphCircle.Init;
begin
  TGraphObject.Init;                { RS addition will display X and Y }
  Radius := 20 + Random(20);
  Write('   Radius = ',Radius:3);   { RS addition to display radius for  }
end;                                { checking by DOS Debug graphics.stm }

procedure TGraphCircle.Draw;
begin
  Circle(X, Y, Radius);
end;

procedure TGraphCircle.Store(var S: TStream);
begin
  TGraphObject.Store(S);
  S.Write(Radius, SizeOf(Radius));
end;

{ TGraphRect }
constructor TGraphRect.Init;
begin
  TGraphObject.Init;               { RS addition will display X and Y }
  Width := 10 + Random(20) + X;
  Height := 6 + Random(15) + Y;
  write('   Width = ',Width:3,'   Height = ',Height:3);  { RS addition to }
end;                                                     { display width  }
                                                         { and height     }
procedure TGraphRect.Draw;
begin
  Rectangle(X, Y, X + Width, Y + Height);
end;

procedure TGraphRect.Store(var S: TStream);
begin
  TGraphObject.Store(S);
  S.Write(Width, SizeOf(Width));
  S.Write(Height, SizeOf(Height));
end;

{ ********************************** }
{ **  Stream Registration Records ** }
{ ********************************** }

const
  RGraphPoint: TStreamRec = (
    ObjType: 150;
    VmtLink: Ofs(TypeOf(TGraphPoint)^);
    Load: nil;                             { No load method yet }
    Store: @TGraphPoint.Store);

  RGraphCircle: TStreamRec = (
    ObjType: 151;
    VmtLink: Ofs(TypeOf(TGraphCircle)^);
    Load: nil;                             { No load method yet }
    Store: @TGraphCircle.Store);

  RGraphRect: TStreamRec = (
    ObjType: 152;
    VmtLink: Ofs(TypeOf(TGraphRect)^);
    Load: nil;                             { No load method yet }
    Store: @TGraphRect.Store);


{ ********************************** }
{ ************  Globals ************ }
{ ********************************** }

{ Abort the program and give a message }

procedure Abort(Msg: String);
begin
  Writeln;
  Writeln(Msg);
  Writeln('Program aborting');
  Halt(1);
end;

{ Register all object types that will be put onto the stream.
  This includes standard TVision types, like TCollection.
}

procedure StreamRegistration;
begin
  writeln('DETAILS OF STREAM REGISTRATION');
  RegisterType(RCollection);
  RegisterType(RGraphPoint);
  Writeln;
  writeln('RGraphPoint.ObjType: ',RGraphPoint.ObjType);
  writeln('RGraphPoint.VmtLink: ',RGraphPoint.VmtLink);
  writeln;
  RegisterType(RGraphCircle);
  writeln('RGraphCircle.ObjType: ',RGraphCircle.ObjType);
  writeln('RGraphCircle.VmtLink: ',RGraphCircle.VmtLink);
  writeln;
  RegisterType(RGraphRect);
  writeln('RGraphRect.ObjType: ',RGraphRect.ObjType);
  writeln('RGraphRect.VmtLink: ',RGraphRect.VmtLink);
  writeln;
  write('Press any key to continue ');
  answer := readkey;                     { Pause to view registration data }
  ClrScr;
end;

{ Put the system into graphics mode }

procedure StartGraphics;
var
  Driver, Mode: Integer;
begin
  Driver := Detect;
  InitGraph(Driver, Mode, PathToDrivers);
  if GraphResult <> GrOK then
  begin
    Writeln(GraphErrorMsg(Driver));
    if Driver = grFileNotFound then
    begin
      Writeln('in ', PathToDrivers,
        '. Modify this program''s "PathToDrivers"');
      Writeln('constant to specify the actual location of this file.');
      Writeln;
    end;
    Writeln('Press Enter...');
    Readln;
    Halt(1);
  end;
end;

{ Use the ForEach iterator to traverse and
  show all the collection of graphical objects.
}

procedure DrawAll(C: PCollection);

{ Nested, far procedure. Receives one
  collection element--a GraphObject, and
  calls that elements Draw method.
}

procedure CallDraw(P: PGraphObject); far;
begin
  P^.Draw;                            { Call Draw method }
end;

begin { DrawAll }
  C^.ForEach(@CallDraw);              { Draw each object }
end;

{ Instantiate and draw a collection of objects }

procedure MakeCollection(var List: PCollection);
var
  I: Integer;
  P: PGraphObject;
begin
  { Initialize collection to hold 10 elements first, then grow by 5's }
  List := New(PCollection, Init(10, 5));

  for I := 1 to 12 do
  begin
    case I mod 3 of                      { Create it }
      0: P := New(PGraphPoint, Init);
      1: P := New(PGraphCircle, Init);
      2: P := New(PGraphRect, Init);
    end;
    writeln;
    List^.Insert(P);                     { Add it to collection }
  end;
  writeln;
  write('Press any key to continue ');
  reply := readkey;                     { Pause to view data }
end;


Function DebugPath : Pathstr;

var
  DPath : PathStr;

begin
  DPath := '';
  DPath := FSearch('DEBUG.EXE', GetEnv('PATH'));
  If DPath = '' then DPath := FSearch('DEBUG.COM', GetEnv('PATH'));
  If DPath = '' then
     begin
        writeln('DEBUG file not found. Please check your DOS system.');
        writeln;
        writeln('Press any key to continue: ');
        repeat until keypressed;
     end;
  DebugPath := DPath;
end;      {of Function DebugPath}


{ ********************************** }
{ **********  Main Program ********* }
{ ********************************** }

var
  GraphicsList  : PCollection;
  GraphicsStream: TBufStream;


  HeapOrgSeg,HeapOrgOfs          : word;
  HeapOrgSegX,HeapOrgOfsX        : string;
  HeapPtrSeg,HeapPtrOfs          : word;
  HeapPtrSegX,HeapPtrOfsX        : string;
  HeapOrg                        : ^integer;
  i                              : integer;


begin
  ClrScr;

  Writeln;
  Mark(HeapOrg);
  HeapOrgSeg := seg(HeapOrg^);
  HeapOrgOfs := ofs(HeapOrg^);

  dec2hex(HeapOrgSeg,HeapOrgSegX);
  dec2hex(HeapOrgOfs,HeapOrgOfsX);


  Randomize;
  StreamRegistration;                   { Register all streams }
  StartGraphics;                        { Activate graphics }
  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Closegraph;
  TextMode(3);                          { Switch back to text mode }
  for i := HeapOrgOfs to (HeapOrgOfs + 1000) do Mem[HeapOrgSeg:i] := 0;
  writeln('DETAILS OF GRAPHICAL SHPAES');
  writeln;

  { Make the collection }
  MakeCollection(GraphicsList);         { Generate and collect figures }
  HeapPtrSeg := seg(HeapPtr^);
  HeapPtrOfs := ofs(HeapPtr^);
  dec2hex(HeapPtrSeg,HeapPtrSegX);
  dec2hex(HeapPtrOfs,HeapPtrOfsX);



  StartGraphics;                        { Re-activate graphics }
  DrawAll(GraphicsList);                { Use iterator to draw all }
  OutTextXY(10,470,'Press any key to continue ');
  reply := readkey;                     { Pause to view figures }

  { Put the collection in a stream on disk }
  GraphicsStream.Init('GRAPHICS.STM', stCreate, 1024);
  GraphicsStream.Put(GraphicsList);     { Output collection }
  GraphicsStream.Done;                  { Shut down stream }
  CloseGraph;
  TextMode(3);
  writeln('CHECK OF MEMORY FOR THE COLLECTION OF GRAPHICAL SHAPES.');
  writeln;
  writeln('HeapOrg:    ',HeapOrgSegX,':',HeapOrgOfsX);
  writeln('HeapPtr:    ',HeapPtrSegX,':',HeapPtrOfsX);
  writeln;
  writeln('DOS Debug now entered from program by means of Exec procedure.');
  writeln('Please type D followed by a space and then the HeapOrg address, as above.');
  writeln('Then continue to type D until end of collection. Then type Q.');
  SwapVectors;
  Exec(DebugPath,'');
  If DosError <> 0 then writeln('Dos error # ',DosError);
  ClrScr;
  writeln('DOS Debug now used to inspect the stream file GRAPHICS.STM.');
  writeln('Just type D to inspect and eventually type Q to quit.');
  writeln;
  Exec(DebugPath,'graphics.stm');
  If DosError <> 0 then writeln('Dos error # ',DosError);
  SwapVectors;
  { Clean up }
  Dispose(GraphicsList, Done);          { Delete collection }
end.